home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / dbase / lib19.zip / SCREEN.PRG < prev    next >
Text File  |  1992-09-28  |  53KB  |  1,297 lines
  1. *-------------------------------------------------------------------------------
  2. *-- Program...: SCREEN.PRG
  3. *-- Programmer: Ken Mayer (KENMAYER)
  4. *-- Date......: 09/15/1992
  5. *-- Notes.....: A few routines not left in PROC.PRG, these are not used as much
  6. *--             by my own systems. See the file: README.TXT for details on how
  7. *--             to use this library file.
  8. *-------------------------------------------------------------------------------
  9.  
  10. FUNCTION Radio
  11. *-------------------------------------------------------------------------------
  12. *-- Programmer..: Ed Lafferty (GICHIN)
  13. *-- Date........: 06/08/1992
  14. *-- Notes.......: Routine to create and size a popup with radio buttons
  15. *--               for choosing only one of up to four options.  Pressing
  16. *--               the <Space Bar> on an option turns it on or off.
  17. *--               Pressing <Enter> chooses the selected option and leaves
  18. *--               the routine.
  19. *-- Written for.: dBase IV, 1.1
  20. *-- Rev. History: 02/25/1992 - original procedure.
  21. *--               02/27/1992 -- Ken Mayer -- added option for color, but had
  22. *--               to take number of choices back to 4 to do so. Minor 
  23. *--               alterations performed to add color choice ... and cleaning
  24. *--               up after self ... (original cleared the screen first ...
  25. *--               this version saves screen, restores back to it ...) Oh yeah,
  26. *--               I turned it into a function, rather than a procedure, as well.
  27. *-- Calls.......: CENTER                Procedure in PROC.PRG
  28. *--               SHADOW                Procedure in PROC.PRG
  29. *--               COLORBRK()            Function in PROC.PRG
  30. *-- Called by...: Any
  31. *-- Usage.......: Radio(<nULRow>,<nULCol>,<nChoice>,"<cTxt1>","<cTxt2>",;
  32. *--                        "<cTxt3>","<cTxt4>","<cTitle>","<cColor>")
  33. *-- Example.....: cPort = Radio(8,15,1,"LPT1","LPT2","LPT3","",;
  34. *--                             "Choose a printer port","rg+/gb,n/w,rg+/gb")
  35. *-- Returns.....: number of chosen button in nChoice
  36. *-- Parameters..: nUlrow  = upper left row of popup
  37. *--               nUlcol  = upper left column of popup
  38. *--               nChoice = default chosen button
  39. *--               cTxt1   = Text for 1st button
  40. *--               cTxt2   =  "    "  2nd   "
  41. *--               cTxt3   =  "    "  3rd   "
  42. *--               cTxt4   =  "    "  4th   "
  43. *--               cTitle  = Text for the box title
  44. *--               cColor  = Color string (i.e., "RG+/GB,N/W,RG+/GB")
  45. *-------------------------------------------------------------------------------
  46.  
  47.     parameters nUlrow, nUlcol, nChoice, cTxt1, cTxt2, cTxt3, cTxt4, ;
  48.                     cTitle, cColor
  49.     private nHeight, nKey, nCnt, nWidth, cStr, cTxt0, cMidCol, cFirstCol,;
  50.                    cCursor
  51.     
  52.     cCursor = set("CURSOR")
  53.     store cTitle to cTxt0
  54.     save screen to sRadio
  55.     store 0 to nHeight, nKey, nCnt, nWidth
  56.     store nChoice to nOrig  && in case user presses <Esc> to exit ...
  57.     
  58.     *-- deal with these colors in displaying some stuff ...
  59.     cMidCol = colorbrk(cColor,2)
  60.     *-- First color (for message) is easier ...
  61.     cFirstCol = colorbrk(cColor,1)
  62.     
  63.     *-- Determine height and width of popup
  64.     do case
  65.         case len(cTxt4) > 0
  66.            nHeight = 4
  67.         case len(cTxt3) > 0
  68.            nHeight = 3
  69.         case len(cTxt2) > 0
  70.            nHeight = 2
  71.         otherwise
  72.            nHeight = 1
  73.     endcase
  74.     
  75.     do while nCnt <=nHeight
  76.        store "cTxt"+str(nCnt,1) to cStr
  77.        if len(&cstr) > nWidth
  78.           nWidth = len(&cStr)
  79.        endif
  80.        nCnt = nCnt + 1
  81.     enddo
  82.     
  83.     *-- create popup
  84.     define window wRadio from nUlRow,nUlCol to nUlRow+nHeight+3,nUlCol+nWidth+9;
  85.             double color &cColor
  86.     do center with 23,80,"&cFirstCol","Press "+chr(24)+chr(25)+;
  87.                                     ", <Space> to select/de-select, <Enter> to quit"
  88.     activate screen
  89.     do shadow with nULRow, nULCol, nULRow+nHeight+3, nULCol+nWidth+9
  90.     activate window wRadio
  91.     
  92.     *-- display screen
  93.     store 1 to nCnt
  94.     do center with 0, nWidth+8, "", cTitle
  95.     do while nCnt <= nHeight
  96.        store "cTxt"+str(nCnt,1) to cStr
  97.        @ nCnt+1, 2 SAY "[ ]" color &cMidCol
  98.         @ nCnt+1, 6 say &cStr
  99.        nCnt = nCnt + 1
  100.     enddo
  101.     
  102.     *-- prepare for and get nChoice
  103.     if nChoice > 0
  104.        store nChoice to nCnt
  105.         @nCnt+1,3 say "■" color &cMidCol
  106.     else
  107.        store 1 to nCnt
  108.     endif
  109.     store .F. to ldone
  110.     
  111.     *-- this loop processes user input ... 
  112.     do while .not. ldone
  113.         @ nCnt+1,3 say "" color &cMidCol
  114.         nkey = inkey(0)
  115.         do case
  116.         case nkey = 27                   && Press Esc to exit
  117.            store nOrig to nChoice        && Leave at "default"
  118.            store .T. to ldone
  119.         case nkey = 13
  120.            store .T. to ldone
  121.         case nkey = 32                   && Press Enter or Space
  122.               set cursor off
  123.               if nChoice = nCnt
  124.                  @ nCnt+1,3 say " " color &cMidCol
  125.                  store 0 to nChoice
  126.               else
  127.                  @ nChoice+1,3 say " " color &cMidCol
  128.                  @ nCnt+1,3 say "■" color &cMidCol
  129.                  store nCnt to nChoice
  130.               endif
  131.               set cursor on
  132.         case nkey = 5                    && Press up arrow
  133.            if nCnt > 1
  134.               nCnt = nCnt - 1
  135.            else
  136.               nCnt = nHeight
  137.            endif
  138.         case nkey = 24                   && Press down arrow
  139.            if nCnt < nHeight
  140.               nCnt = nCnt + 1
  141.            else
  142.               nCnt = 1
  143.            endif
  144.         endcase
  145.     enddo
  146.     
  147.     *-- cleanup
  148.     deact window wRadio
  149.     release window wRadio
  150.     restore screen from sRadio
  151.     release screen sRadio
  152.     set message to
  153.     set cursor &cCursor
  154.     
  155. RETURN nChoice
  156. *-- EoF: Radio()
  157.  
  158. PROCEDURE CheckBox
  159. *-------------------------------------------------------------------------------
  160. *-- Programmer..: Ed Lafferty (GICHIN)
  161. *-- Date........: 02/28/1992
  162. *-- Notes.......: Routine to create and size a popup with check boxes
  163. *--               for choosing any of a number (up to five) options.  Pressing
  164. *--               the <Space Bar> on an option turns it on or off.
  165. *--               Pressing <Enter> chooses the selected option and leaves
  166. *--               the routine. You must use a data structure with logical
  167. *--               fields, or memvars that are logical for this. Either way,
  168. *--               even if you don't use five logical fields/memvars, you must
  169. *--               pass a field/memvar to the procedure -- see Example below 
  170. *--               (the logicals -- lCHK1, lCHK2, etc.-- must be fields or
  171. *--               memvars due to a limitation in parameter passing in dBASE IV.)
  172. *-- Written for.: dBase IV, Version 1.1
  173. *-- Rev. History: 02/25/1992 - original procedure.
  174. *--               02/28/1992 -- Ken Mayer -- modified to allow passing cColor,
  175. *--               and a little cleanup of code and such. Minor changes.
  176. *-- Calls.......: CENTER               Procedure in PROC.PRG
  177. *--               SHADOW               Procedure in PROC.PRG
  178. *--               COLORBRK()           Function in PROC.PRG
  179. *-- Called by...: Any
  180. *-- Usage.......: do checkbox with <nULCol>,<nULRow>,<lchk1>,<lchk2>,<lchk3>,;
  181. *--                          <lchk4>,"<cTxt1>","<cTxt2>","<cTxt2>",;
  182. *--                          "<cTxt3>","<cTxt4>","<cTxt0>","<cColor>"
  183. *-- Example.....: do Checkbox with 8, 15, lchk1, lchk2, lchk3, lchk4,;
  184. *--                    "LPT1", "LPT2", "LPT3","","Choose a printer port",;
  185. *--                    "rg+/gb,w+/n,rg+/gb"
  186. *-- Returns.....: .T. for selected items, .F. for non-selected items --
  187. *--               this routine changes the value of the logical fields passed
  188. *--               to it.
  189. *-- Parameters..: nULRow = upper left row of popup
  190. *--               nULCol = upper left column of popup
  191. *--               lChkn  = default value of box 'n' -- MUST BE FIELDS/MEMVARS
  192. *--               cTxt1  = Text for 1st box
  193. *--               cTxt2  =  "    "  2nd   "
  194. *--               cTxt3  =  "    "  3rd   "
  195. *--               cTxt4  =  "    "  4th   "
  196. *--               cTxt0  = Text for the box title
  197. *--               cColor = Colors to be used in window ...
  198. *-------------------------------------------------------------------------------
  199.  
  200.     parameters nUlrow, nUlcol, lChk1, lChk2, lChk3, lChk4, ;
  201.                  cTxt1, cTxt2, cTxt3, cTxt4, cTxt0, cColor
  202.     private nHeight, nKey, nCnt, nWidth, lOrig1, lO